class: center, middle, inverse, title-slide # Life expectancy evolution in France ## ⚔
since 1816 ### Corentin Guillaumet, Skandar Mabrouk & Lucas Veeravalli ### University of Paris ### December 14th 2021 --- class: center, middle #Summary - Evolution of mortality quotient since 1816 - How to obtain an estimation for the future - Estimating life expectancies --- class: center, top ##I. Evolution of mortality quotient since 1816 .middle[ .pull-left[ ```r plot1 <- life_table_fr_evol <- life_table %>% filter(Country =='France', Gender != "Both") %>% ggplot() + geom_line(mapping = aes(y= qx, col = Gender, x= Age)) + aes(frame = Year, text = qx) + theme(axis.text.x=element_text(angle=-45, hjust=0, vjust=1)) +xlab("Age") +ylab("Mortality quotient")+ theme(plot.title=element_text(size=12, hjust=0.5, face="bold", colour="maroon", vjust=-1)) + theme(plot.subtitle=element_text(size=10, hjust=0.5, face="italic", color="black")) ``` ] .pull-right[
] ] --- class: center, middle ##II. A. How to obtain an estimation for the future (Computing Lee Carter model) .pull-left[ ```r #FEMALE Years <- 1933:1995 T <- length(Years) Age <- 1:110 A_FRF <- life_table_pivot %>% filter(Country == "France", Gender == 'Female', Year %in% Years) %>% select(-Gender, -Country, -Year) %>% log() %>% as.matrix() M_FRF<- (diag(1,T) - ((1/T)*matrix(1,T,1) %*% t(matrix(1,T,1)))) %*% A_FRF svdFRF <- svd(M_FRF,1,1) sFRF <- svdFRF$d[1] uFRF <- -1 *(svdFRF$u*sFRF) vFRF <- -1 *svdFRF$v axFRF <- colMeans(A_FRF) ``` ] .pull-right[ <!-- --> ] --- class: center, middle ###II. B. Comparing Norms (SVD Rank 2 vs Lee Carter) .pull-left[ ```r res_FRF <- svd(A_FRF) matFRF <- (res_FRF$u[,1:2]) %*% diag(res_FRF$d[1:2])%*%t(res_FRF$v[,1:2]) matLEEFRF = matrix(0,nrow = 63 , ncol = 110) for (i in 1:110){ matLEEFRF[,i] = t(axFRF)[i] +vFRF[i]*uFRF } ``` ] .pull-right[ ```r norm(matFRF - as.matrix(A_FRF) , "F") #9.684005 ``` ``` ## [1] 9.684005 ``` ```r norm(matLEEFRF -as.matrix(A_FRF), "F") #10.07679 ``` ``` ## [1] 10.07679 ``` ] --- class: center, middle ##II. C. Computing and displaying Lee Carter parameters .middle[ .pull-left[ ```r LC <- lc() #Leecarter function from StMoMo on a demogdata object FRF <- StMoMoData(FRfemale , series = "Female") #Transforming a demogdata FRfemale object into StMoMoData object ages.fit <- 1:110 years.fit <- 1945:1995 LCfit1 <- fit(LC, data =FRF , ages.fit=ages.fit , years.fit=years.fit) #Lee Carter Function from StMoMo ``` ``` ## StMoMo: The following cohorts have been zero weigthed: 1835 1836 ## StMoMo: Start fitting with gnm ## Initialising ## Running start-up iterations.. ## Running main iterations.......... ## Done ## StMoMo: Finish fitting with gnm ``` ```r #Forecasting LCforFRF <- forecast(LCfit1, h=20) ``` ] .pull-right[ <!-- --> ] ] --- class: center, middle ##III. Estimating life expectancies with demography .middle[ .pull-left[ ```r ex_predicted_fr_female <- tibble() for (a in 0:109){ lf <- flife.expectancy(FRfemale, series = names(FRfemale$rate)[1], years = FRfemale$year, age=a+1, max.age = 110) lf <- as.vector(t(tibble(lf))) ex_predicted_fr_female <- rbind(ex_predicted_fr_female,lf) } colnames(ex_predicted_fr_female) <- 1816:2017 ex_predicted_pivot_fr_female <- as.data.frame(t(ex_predicted_fr_female)) Country <- rep("France", 202) Gender <- rep("Female", 202) Year <- 1816:2017 colnames(ex_predicted_pivot_fr_female) <- 0:109 ex_predicted_pivot_fr_female <-cbind(Country,Gender, Year,ex_predicted_pivot_fr_female) ex_observed_pivot_fr_female <- as.data.frame(ex_life_table_pivot %>% filter(Country == "France", Gender == "Female")) ``` ] .pull-right[
] ]